home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Developer's Kit 1996
/
Delphi Developer's Kit 1996.iso
/
power
/
timetest
/
timer.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-12-22
|
6KB
|
212 lines
unit Timer;
interface
{ This is a simple program for comparing the execution time of two
methods.
test_0 is the setup method. Initialize any test arrays or
conditions.
test_1 is executed by the Test 1 button N Iteration times.
test_2 is executed by the Test 2 button N Iteration times.
Timing accuracy is +/- .055 seconds, so any test should exceed
a second or two to be meaningful. Test 1 is often 1 tick faster
than Test 2. I am guessing the events are handled in a consistent
fashion relative to clock ticks, and so the start time for 1
is closer to the last tick before it runs. Maybe.
Do several tests in case there are hardware interrupts which
might invalidate any single test.
This is handy for comparing local vs global variables, near vs far
calls, and implementation of parts of functions in assembler.
I am new to Delphi, new to Windows, and new to Pascal, any tips
or constructive criticism would be appreciated.
Placed in the public domain, 1995 by Peter Jennings.
Comments to peterj@netcom.com
}
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Panel1: TPanel;
Label2: TLabel;
Label3: TLabel;
Single: TLabel;
Niter: TEdit;
Plus: TButton;
Minus: TButton;
Exit: TButton;
Test1: TButton;
Test2: TButton;
T1Addr: TLabel;
T2Addr: TLabel;
Single2: TLabel;
Total: TLabel;
Total2: TLabel;
procedure ExitClick(Sender: TObject);
procedure PlusClick(Sender: TObject);
procedure MinusClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Test1Click(Sender: TObject);
procedure Test2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
NIterations : LongInt;
buf : array[0..8200] of char;
function HWToStr(w: Word): String;
procedure test_0;
procedure test_1;
procedure test_2;
function StrPosi(var Buffer;Size: word;S: string): integer;
implementation
{$R *.DFM}
procedure TForm1.ExitClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.PlusClick(Sender: TObject);
begin
NIterations := StrtoInt( NIter.Text );
if NIterations < 1000000000 then
NIterations := NIterations * 10;
NIter.Text := InttoStr(NIterations);
end;
procedure TForm1.MinusClick(Sender: TObject);
begin
NIterations := StrtoInt( NIter.Text );
NIterations := NIterations div 10;
If NIterations < 1 then
NIterations := 1;
NIter.Text := InttoStr(NIterations);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
test_0;
T1Addr.Caption := HWToStr(Seg(test_1)) +':'+ HWToStr(Ofs(test_1));
T2Addr.Caption := HWToStr(Seg(test_2)) +':'+ HWToStr(Ofs(test_2));
end;
procedure TForm1.Test1Click(Sender: TObject);
var
NIterations : LongInt;
BeginTime : TDateTime;
ElapsedTime : double;
i : LongInt;
begin
NIterations := StrtoInt( NIter.Text );
Screen.Cursor := crHourGlass;
Single.Caption := '- - - -';
total.Caption := '- - - -';
Application.ProcessMessages;
BeginTime := Now;
for i := 1 to NIterations do
begin
Test_1;
end;
ElapsedTime := ((Now - BeginTime) * 86400.0);
total.Caption := FloatToStrF(ElapsedTime, ffNumber, 4, 2);
single.Caption := FloatToStrF(ElapsedTime/NIterations, ffNumber, 10,6);
Screen.Cursor := crDefault;
end;
procedure TForm1.Test2Click(Sender: TObject);
var
BeginTime : TDateTime;
ElapsedTime : double;
i : LongInt;
begin
NIterations := StrtoInt( NIter.Text );
Screen.Cursor := crHourGlass;
Single2.Caption := '- - - -';
total2.Caption := '- - - -';
Application.ProcessMessages;
BeginTime := Now;
for i := 1 to NIterations do
begin
test_2
end;
ElapsedTime := ((Now - BeginTime) * 86400.0);
total2.Caption := FloatToStrF(ElapsedTime, ffNumber, 4, 2);
single2.Caption := FloatToStrF(ElapsedTime/NIterations, ffNumber, 10,6);
Screen.Cursor := crDefault;
end;
function HWToStr(w: Word): string;
const
hex: array [0..15] of Char ='0123456789ABCDEF';
var
H : String;
begin
HWToStr := hex[Hi(w) shr 4] + hex[Hi(w) and $F]
+ hex[Lo(w) shr 4] + hex[Lo(w) and $F];
end;
{ ----------------- place the test methods here ----------------------}
{ This example compares the execution time for a search of an 8K buffer
using StrPos vs an assembler function. 11.48 vs 6.38 seconds for 12,500
iterations on a 486/100 laptop.Your mileage may vary.}
procedure test_0; { initialization for test }
var
i : integer;
begin
for i := low(buf) to high(buf) do buf[i] := char(random(26)+ord('a'));
StrCopy(buf+8000,'findme');
end;
procedure test_1; { perform test 1 }
var
p : PChar;
begin
p := StrPos(buf, 'findme');
end;
procedure test_2; { perform test 2 }
var
i : integer;
begin
i := StrPosi(buf,8200,'findme');
end;
function StrPosi(var Buffer;Size: word;S: string): integer;
begin
Inline($1E/$16/$1F/$C4/$BE/>buffer/$89/$FB/$8B/$8E/>size/$8D/$B6/>s+2/
$8A/$86/>s+1/$8A/$96/>s/$84/$D2/$74/$23/$FE/$CA/$30/$F6/$29/$D1/
$76/$1B/$FC/$F2/$AE/$75/$16/$85/$D2/$74/$0C/$51/$57/$56/$89/$D1/
$F3/$A6/$5E/$5F/$59/$75/$EC/$89/$F8/$29/$D8/$EB/$02/$31/$C0/
$89/$46/$FE/$1F)
end;
end.